home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / MOREHEAP.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-04  |  2KB  |  68 lines
  1. UNIT MoreHeap;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Expands heap with available UMB               Last changed: 04.03.97  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-97 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. IMPLEMENTATION
  16.  
  17. USES OpInline;
  18.  
  19. TYPE
  20.   PFreeRec = ^TFreeRec;
  21.   TFreeRec = RECORD
  22.     Next : PFreeRec;
  23.     Size : Pointer;
  24.   END;
  25.  
  26.   PROCEDURE AddHeapBlock(P: Pointer; BlockSize: LongInt);
  27.   VAR
  28.     FreeRec : PFreeRec;
  29.  
  30.     function Linear(P: pointer): longint;
  31.     begin
  32.       Linear := (longint(seg(P^)) shl 4) + ofs(P^)
  33.     end;
  34.  
  35.     FUNCTION CalcSize(StartPtr,EndPtr: Pointer): Pointer;
  36.     BEGIN
  37.       IF Ofs(EndPtr^) >= Ofs(StartPtr^) THEN
  38.         CalcSize := Ptr(Seg(EndPtr^)-Seg(StartPtr^), Ofs(EndPtr^)-Ofs(StartPtr^))
  39.       ELSE
  40.         CalcSize := Ptr(Seg(EndPtr^)-Seg(StartPtr^)-1, Ofs(EndPtr^)-Ofs(StartPtr^)+16);
  41.     END;
  42.  
  43.   BEGIN
  44.     IF Linear(P)<Linear(HeapPtr) THEN
  45.     BEGIN
  46.       FreeRec:=FreeList;
  47.       WHILE Linear(FreeRec)<Linear(P) DO
  48.         FreeRec:=FreeRec^.Next;
  49.       PFreeRec(P)^.Size:=CalcSize(P, AddLongToPtr(P,BlockSize));
  50.       PFreeRec(P)^.Next:=FreeRec^.Next;
  51.       FreeRec^.Next:=P;
  52.     END ELSE
  53.     BEGIN
  54.       FreeRec := HeapPtr;
  55.       WITH FreeRec^ DO
  56.       BEGIN
  57.          Next:=P;
  58.          Size:=CalcSize(P, AddLongToPtr(P,BlockSize));
  59.        END;
  60.        HeapPtr:=Normalized(P);
  61. {      SaveHeapEnd:=HeapEnd;}
  62.        HeapEnd:=AddLongToPtr(P,BlockSize);
  63. {      Ptr(seg(HeapPtr^)+Size,ofs(HeapPtr^));}
  64.     END;
  65.   END;
  66.  
  67. END.
  68.